home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / windows.arc / WNDW_RTN.PAS < prev   
Pascal/Delphi Source File  |  1986-02-06  |  14KB  |  412 lines
  1. Program WindowDemo;
  2.  
  3. { WINDOW DEMONSTRATION IN TURBO PASCAL --
  4.  
  5.   Translated from BASIC by Lars Ecklund 12/19/85
  6.  
  7. Comments:     This program is IBM-PC specific in regard to the GetChar
  8.            procedure and Screen function.
  9.  
  10.               Those inclined may wish to make the Window data arrays into
  11.            one single record.
  12.  
  13.               Programmers thinking of implementing these procedures will
  14.            probably want to restructure them a bit... They are a little
  15.            messy!                                                        }
  16.  
  17. const
  18.      MaxWindows = 20;
  19.      MaxHSelectWidth = 5;
  20.      HNumSelections  = 5;
  21.      HSelectWidth    = 10;
  22.      MaxVSelections  = 4;
  23.      MaxVSelectWidth = 12;
  24.      CR              = 13;
  25.      ESC             = 27;
  26.      MonoChrome = $B000;
  27.      Colour     = $B800;
  28.  
  29. type
  30.      WindowInfo  = array[1..MaxWindows] of byte;
  31.      HSelections = array[1..HNumSelections] of string[MaxHSelectWidth];
  32.      VSelections = array[1..MaxVSelections] of string[MaxVSelectWidth];
  33.      String80    = String[80];
  34.  
  35. var
  36.      NumWindows                        : byte;
  37.      NumLines                          : integer;
  38.      WindowX,WindowY,WindowH,WindowW   : WindowInfo;
  39.      SStr                              : array[1..4000] of char;
  40.  
  41. Procedure GotoWXY(W,X,Y:byte);
  42. { Place cursor at relative (X,Y) coordinates in window w }
  43. begin
  44.      GotoXY(X+WindowX[W],Y+WindowY[W]);
  45. end; { Goto (x,y) within window }
  46.  
  47. Procedure WriteText(TStr:String80; X,Y,W:byte; Inverse:boolean);
  48. var
  49.      StringSize:byte;
  50. begin
  51.      if Length(TStr)>WindowW[W] then
  52.          StringSize:=WindowW[W]
  53.      else
  54.          StringSize:=Length(TStr);
  55.      if Inverse then { Inverse text colour } begin
  56.          TextColor(0); TextBackGround(7); end;
  57.      GotoWXY(W,X,Y);            { If too big to fit in window, }
  58.      Write(Copy(TStr,1,StringSize)); { truncate the text. }
  59.      if Inverse then { Restore screen colours } begin
  60.          TextColor(7); TextBackGround(0); NormVideo; end;
  61. end; { Write Text }
  62.  
  63. Procedure DisplayInitialText;
  64. var
  65.      TStr    : String80;
  66.      X,Y,W   : byte;
  67. begin
  68.      X:=1; Y:=4; W:=1;
  69.      TStr:='This is a dummy main screen to show you how Turbo can be used for';
  70.      WriteText(TStr,X,Y,W,False);
  71.  
  72.      Y:=Y+1; TStr:='making windows and menus.';
  73.      WriteText(TStr,X,Y,W,False);
  74.  
  75.      Y:=Y+2; TStr:='Windows can definately enhance the user interface, providing a';
  76.      WriteText(TStr,X,Y,W,False);
  77.  
  78.      Y:=Y+1; TStr:='clear way of displaying multiple events on one screen. They can';
  79.      WriteText(TStr,X,Y,W,False);
  80.  
  81.      Y:=Y+1; TStr:='also be used for menu selections and other prompts, as demonstrated';
  82.      WriteText(TStr,X,Y,W,False);
  83.  
  84.      Y:=Y+1; TStr:='in this program.';
  85.      WriteText(TStr,X,Y,W,False);
  86.  
  87.      Y:=Y+2; TStr:='To make a selection, just use the arrow keys to "point" to the';
  88.      WriteText(TStr,X,Y,W,False);
  89.  
  90.      Y:=Y+1; TStr:='desired selection. On a horizontal menu, use the left and right';
  91.      WriteText(TStr,X,Y,W,False);
  92.  
  93.      Y:=Y+1; TStr:='keys to make the selection. On a vertical, "pull-down" menu, use';
  94.      WriteText(TStr,X,Y,W,False);
  95.  
  96.      Y:=Y+1; TStr:='the up and down arrow keys. Once your selection has been made,';
  97.      WriteText(TStr,X,Y,W,False);
  98.  
  99.      Y:=Y+1; TStr:='press <CR>. That''s all there is to making a selection!';
  100.      WriteText(TStr,X,Y,W,False);
  101.  
  102.      Y:=Y+3; TStr:='Press any key to continue with this demo...';
  103.      WriteText(TStr,X,Y,W,False);
  104. end; { Display initial text }
  105.  
  106. Function Screen(X,Y:byte) : char;
  107. { Returns char at (X,Y) coor on screen }
  108. var
  109.      Mode : byte;
  110.      VideoSegment : integer;
  111. begin
  112.      Mode:=Mem[$0040:$0049];  { Grab screen attribute byte }
  113.      if (Mode=2) or (Mode=3) then { RGB monitor }
  114.          VideoSegment:=Colour
  115.      else { Monochrome monitor }
  116.          VideoSegment:=MonoChrome;
  117.      Screen:=chr(Mem[VideoSegment:(X-1)*2+((Y-1)*160)]);
  118. end; { Function screen }
  119.  
  120. Procedure SaveText(X,Y,WWidth,WHeight:byte);
  121. var
  122.      IY,IX : byte;
  123. begin
  124.      WWidth:=WWidth+2; WHeight:=WHeight+2; { Add 2 chars for border }
  125.      for IY:=Y to (Y+WHeight-1) do { Copy each row into SStr }
  126.          for IX:=X to (X+WWidth-1) do { Copy each char to SStr } begin
  127.               SStr[NumLines]:=Screen(IX,IY);
  128.               NumLines:=NumLines+1;
  129.          end;
  130. end; { Save Text }
  131.  
  132. Procedure DrawWindow(X,Y,WWidth,WHeight:byte);
  133. var
  134.      IY,I          : byte;
  135.      BarStr,SPCStr : String80;
  136. begin
  137.          BarStr:=''; SPCStr:='';
  138.      for i:=1 to WWidth do begin      { Prepare two strings for use }
  139.          BarStr:=BarStr+chr(196);     { in drawing the window   }
  140.          SPCStr:=SPCStr+chr(32); end;
  141.      GotoXY(X,Y);                     { Draw the top of the }
  142.      Write(chr(218),BarStr,chr(191)); { window   }
  143.      for iy:=(Y+1) to (Y+WHeight-1) do begin   { Draw the middle of the }
  144.          GotoXY(X,IY);                         { window }
  145.          Write(chr(179),SPCStr,chr(179)); end;
  146.      GotoXY(X,Y+WHeight-1);           { Draw the bottom of the }
  147.      Write(chr(192),BarStr,chr(217)); { window }
  148. end; { Draw window }
  149.  
  150. Procedure AddWindow(X,Y,WWidth,WHeight:byte);
  151. { x,y             = (x,y) coordinates for upperleft of window
  152.   WWidth, WHeight = window's width, wheight             }
  153. begin
  154.      NumWindows:=NumWindows+1; { Add one more window }
  155.      WindowX[NumWindows]:=X; { Record window parameters in }
  156.      WindowY[NumWindows]:=Y; { window arrays }
  157.      WindowW[NumWindows]:=WWidth;
  158.      WindowH[NumWindows]:=WHeight;
  159.      SaveText(X,Y,WWidth,WHeight); { Save text within window }
  160.      DrawWindow(X,Y,WWidth,WHeight); { Draw the window }
  161. end; { Add window }
  162.  
  163. Procedure InitializeWindowRoutines;
  164. begin
  165.      NormVideo; ClrScr;
  166.      NumLines:=1; NumWindows:=0;
  167.      AddWindow(1,1,77,21);
  168.      DisplayInitialText;
  169.      Sound(440); Delay(30); NoSound;
  170.      Repeat until KeyPressed;
  171. end; { Initialize window routines }
  172.  
  173. Procedure RestoreText(X,Y,WWidth,WHeight:byte);
  174. var
  175.      IX,IY : byte;
  176. begin
  177.      WWidth:=WWidth+2; WHeight:=WHeight+2; { Add 2 chars for border }
  178.      for IY:=(Y+WHeight-1) downto Y do
  179.          for IX:=(X+WWidth-1) downto X do begin
  180.               GotoXY(IX,IY);
  181.               NumLines:=NumLines-1;
  182.               Write(SStr[NumLines]);
  183.          end;
  184. end; { Restore text }
  185.  
  186. Procedure RemoveWindow;
  187. { Remove the last window generated }
  188. var
  189.      X,Y,WWidth,WHeight : byte;
  190. begin
  191.      X      :=WindowX[NumWindows];    { Let (X,Y) equal upper left }
  192.      Y      :=WindowY[NumWindows];    { of window to remove. }
  193.      WWidth :=WindowW[NumWindows];    { Window's width }
  194.      WHeight:=WindowH[NumWindows];    { Window's height }
  195.      NumWindows:=NumWindows-1;        { One less window now }
  196.      RestoreText(X,Y,WWidth,WHeight); { Restore text }
  197. end; { Remove window }
  198.  
  199. Procedure GetChar(var AH,AL:byte);
  200.  
  201. { GetChar subroutine to fetch the scan code of a keypress via
  202.   Turbo Pascal's interrupt facility by Andy Decepida. }
  203.  
  204. type
  205.      RegPack = record
  206.                    AX,BX,CX,DX,BP,SI,DS,ES,Flags:integer;
  207.                end;
  208. var
  209.      Regs:RegPack;
  210. begin
  211.     AH:= $00;
  212.     Regs.AX:=AH shl 8 + AL;
  213.     Intr($16,Regs);
  214.     AH:=Regs.AX shr 8;   { Grab high byte of AX -- contains the scan code  }
  215.     AL:=Regs.AX mod 256; { Grab  low byte of AX -- contains the ascii code }
  216. end; { Procedure GetChar }
  217.  
  218. Function HMenuSelection(HSelectionStr:HSelections; HNumSelections,HSelectionWidth,W:byte; CreateWindow:boolean):byte;
  219. { Hortizontal menu selection
  220.  
  221.   Inputs to this function:
  222.    W               Which window to display the menu within
  223.    HSelectionStr   The text of each menu selection
  224.    HNumSelections  How many selections are in the menu
  225.    HSelectWidth    How many columns each menu item gets
  226.    CreateWindow    If true, create the window, else use the window
  227.                    specified by W
  228.  
  229.    Returns the # of menu selection chosen.   }
  230. label
  231.      ExitHMS;
  232. var
  233.      X,Y,IY,WWidth,WHeight : byte;
  234.      ScanByte,AsciiByte    : byte;
  235.      Selection             : byte;
  236.      TStr                  : String80;
  237. begin
  238.      X:=WindowX[W]; Y:=WindowY[W]; WWidth:=WindowW[W]; WHeight:=WindowH[W];
  239.      if CreateWindow then { Create window if specified } begin
  240.          AddWindow(X,Y,WWidth,WHeight);
  241.          W:=NumWindows; end;
  242.      X:=1; Y:=1; TStr:='';
  243.      for iy:=1 to WWidth do TStr:=TStr+' '; { Blank inside of window only }
  244.      WriteText(TStr,X,Y,W,False); { Clear out the current line }
  245.      for iy:=1 to HNumSelections do { Display the selections } begin
  246.          TStr:=HSelectionStr[iy];
  247.          WriteText(TStr,X,Y,W,False);
  248.          X:=X+HSelectWidth;
  249.      end;
  250.      X:=1; Selection:=1;
  251.      repeat
  252.          WriteText(HSelectionStr[Selection],X,Y,W,True);
  253.          GetChar(ScanByte,AsciiByte);
  254.          case ScanByte of
  255.               75 : { Left arrow } begin
  256.                    if (Selection>1) then begin
  257.                         WriteText(HSelectionStr[Selection],X,Y,W,False);
  258.                         X:=X-HSelectWidth;
  259.                         Selection:=Selection-1;
  260.               end; end;
  261.               77 : { Right arrow } begin
  262.                    if (Selection<HNumSelections) then begin
  263.                         WriteText(HSelectionStr[Selection],X,Y,W,False);
  264.                         X:=X+HSelectWidth;
  265.                         Selection:=Selection+1;
  266.               end; end;
  267.          end;
  268.      until (AsciiByte=CR);
  269. ExitHMS:
  270.      HMenuSelection:=Selection;
  271. end; { Hortizontal menu selection }
  272.  
  273. Function VMenuSelection(W,Selection,HSelectWidth,VNumSelections,VSelectWidth:byte; VSelectionStr:VSelections):byte;
  274. { Vertical pull-down menu ----
  275.  
  276.   Input to this function:
  277.         W                The # of the window holding the hort. menu
  278.         Selection        The item selected on the hortizontal menu
  279.         HSelectWidth     The # of columns for each item in that menu
  280.         VSelectionStr()  A list of each menu item to appear
  281.         VNumSelections   The # of selections in the pull-down menu
  282.         VSelectWidth     How wide the pull-down menu should be
  283.  
  284.   Returns the # of the chosen menu selection }
  285. label
  286.      ExitVMS;
  287. var
  288.      iy,x,y : byte;
  289.      ScanByte,AsciiByte : byte;
  290. begin
  291.      X:=WindowX[W]+(Selection-1)*HSelectWidth;   { Display window for menu }
  292.      Y:=WindowY[W]+2;
  293.      AddWindow(X,Y,VSelectWidth,VNumSelections+2); { Add two chars to height for borders }
  294.      X:=1; Y:=1; W:=NumWindows;
  295.      for iy:=1 to VNumSelections do begin
  296.          WriteText(VSelectionStr[iy],X,Y,W,False);
  297.          Y:=Y+1; end;
  298.      X:=1; Y:=1; Selection:=1;
  299.      repeat
  300.          WriteText(VSelectionStr[Selection],X,Y,W,True);
  301.          GetChar(ScanByte,AsciiByte);
  302.          case ScanByte of
  303.               72 { Up arrow } : begin
  304.                    if (Selection>1) then begin
  305.                         WriteText(VSelectionStr[Selection],X,Y,W,False);
  306.                         Y:=Y-1; Selection:=Selection-1;
  307.               end; end;
  308.               80 { Down arrow } : begin
  309.                    if (Selection<VNumSelections) then begin
  310.                         WriteText(VSelectionStr[Selection],X,Y,W,False);
  311.                         Y:=Y+1; Selection:=Selection+1;
  312.               end; end;
  313.          end;
  314.      until (AsciiByte=CR);
  315. ExitVMS:
  316.      VMenuSelection:=Selection;
  317. end; { Vertical pull-down menu }
  318.  
  319. Procedure Edit;
  320. var
  321.      TStr : String80;
  322.      ScanByte,AsciiByte : byte;
  323. begin
  324.      TStr:='Edit: Enter text, press <ESC> when finished      ';
  325.      WriteText(TStr,1,1,2,False);
  326.      GetChar(ScanByte,AsciiByte);
  327.      repeat until (AsciiByte=ESC);
  328.      TStr:='                                            ';
  329.      WriteText(TStr,1,1,2,False);
  330. end; { Edit }
  331.  
  332. Procedure Exit;
  333. begin
  334.      RemoveWindow;
  335.      RemoveWindow;
  336.      GotoXY(36,12); WriteLn('Good Bye!');
  337.      Halt;
  338. end; { Exit }
  339.  
  340. Procedure Files;
  341. var
  342.      VSelectionStr : VSelections;
  343. begin
  344.      VSelectionStr[1]:='Get';
  345.      VSelectionStr[2]:='Save';
  346.      VSelectionStr[3]:='Delete';
  347.      VSelectionStr[4]:='Return';
  348.      case VMenuSelection(NumWindows,2,HSelectWidth,4,10,VSelectionStr) of
  349.          1 : { Get file;  } Delay(1);
  350.          2 : { Save file; } Delay(1);
  351.          3 : { Del file;  } Delay(1);
  352.          4 : { Do nothing;} Delay(1);
  353.      end;
  354.      RemoveWindow; { Remove the pull-down menu }
  355. end; { Files }
  356.  
  357. Procedure Help;
  358. var
  359.      VSelectionStr : VSelections;
  360. begin
  361.      VSelectionStr[1]:='for Edit';
  362.      VSelectionStr[2]:='for Files';
  363.      VSelectionStr[3]:='for Print';
  364.      VSelectionStr[4]:='Return';
  365.      case VMenuSelection(NumWindows,4,HSelectWidth,4,10,VSelectionStr) of
  366.          1 : { Edit help; } Sound(392);
  367.          2 : { Files help;} Sound(440);
  368.          3 : { Print help;} Sound(880);
  369.          4 : { Do nothing;} Sound(1568);
  370.      end;
  371.          NoSound;
  372.      RemoveWindow; { Remove the pull-down menu }
  373. end; { Help }
  374.  
  375. Procedure Print;
  376. var
  377.      VSelectionStr : VSelections;
  378. begin
  379.      VSelectionStr[1]:='to Printer';
  380.      VSelectionStr[2]:='to Disk';
  381.      VSelectionStr[3]:='Return';
  382.      case VMenuSelection(NumWindows,3,HSelectWidth,3,11,VSelectionStr) of
  383.          1 : { Print to printer; } Delay(8);
  384.          2 : { Print to disk;    } Delay(8);
  385.          3 : { Do nothing...;    } Delay(8);
  386.      end;
  387.      RemoveWindow; { Remove the pull-down menu }
  388. end; { Print }
  389.  
  390. var
  391.      HSelectionStr : HSelections;
  392.      CreateWindow  : boolean;
  393. BEGIN
  394.      InitializeWindowRoutines;
  395.      CreateWindow:=True;
  396.      HSelectionStr[1]:='Edit';
  397.      HSelectionStr[2]:='Files';
  398.      HSelectionStr[3]:='Print';
  399.      HSelectionStr[4]:='Help';
  400.      HSelectionStr[5]:='Exit';
  401.      repeat
  402.          case HMenuSelection(HSelectionStr,HNumSelections,HSelectWidth,NumWindows,CreateWindow) of
  403.               1 : Edit;
  404.               2 : Files;
  405.               3 : Print;
  406.               4 : Help;
  407.               5 : Exit;
  408.          end;
  409.          CreateWindow:=False;
  410.      until { Limbo } (CreateWindow=True);
  411. END. { Main control block }
  412.